package zhdate;

use  strict;
use warnings;

use Carp qw/confess/;
use Date::Calc qw/Add_Delta_Days/;
use Exporter;
use vars qw(@ISA @EXPORT);
push @ISA,    qw(Exporter);
push @EXPORT, qw(&zhDate2wDate $rH19);

$|=1;

my $pt4 = qr/(?>\d{4})/; # non-backtracking 4-digit capturing
my $pt2 = qr/(?>\d{2})/; # non-backtracking 2-digit capturing

#_{{_
my @AChineseYearCode = qw[
  19416
 19168 42352  21717  53856 55632  91476  22176  39632 
 21970 19168  42422  42192 53840 119381  46400  54944 
 44450 38320  84343  18800 42160  46261  27216  27968 
109396 11104  38256  21234 18800  25958  54432  59984 
 92821 23248  11104 100067 37600 116951  51536  54432 
120998 46416  22176 107956  9680  37584  53938  43344 
 46423 27808  46416  86869 19872  42416  83315  21168 
 43432 59728  27296  44710 43856  19296  43748  42352 
 21088 62051  55632  23383 22176  38608  19925  19152 
 42192 54484  53840  54616 46400  46752 103846  38320 
 18864 43380  42160  45690 27216  27968  44870  43872 
 38256 19189  18800  25776 29859  59984  27480  23232 
 43872 38613  37600  51552 55636  54432  55888  30034 
 22176 43959   9680  37584 51893  43344  46240  47780 
 44368 21977  19360  42416 86390  21168  43312  31060 
 27296 44368  23378  19296 42726  42208  53856  60005 
 54576 23200  30371  38608 19195  19152  42192 118966 
 53840 54560  56645  46496 22224  21938  18864  42359 
 42160 43600 111189  27936 44448  84835  37744  18936 
 18800 25776  92326  59984 27296 108228  43744  37600 
 53987 51552  54615  54432 55888  23893  22176  42704 
 21972 21200  43448  43344 46240  46758  44368  21920 
 43940 42416  21168  45683 26928  29495  27296  44368 
 84821 19296  42352  21732 53600  59752  54560  55968 
 92838 22224  19168  43476 41680  53584  62034  54560 
];
# p $rH19;  
# 似乎每19年的重复，不见得是同一个闰月

# 从1900年，至2100年每年的农历春节的公历日期

my @AChineseNewYear = qw[
  19000131
  19010219  19020208  19030129  19040216  19050204
  19060125  19070213  19080202  19090122  19100210
  19110130  19120218  19130206  19140126  19150214
  19160203  19170123  19180211  19190201  19200220
  19210208  19220128  19230216  19240205  19250124
  19260213  19270202  19280123  19290210  19300130
  19310217  19320206  19330126  19340214  19350204
  19360124  19370211  19380131  19390219  19400208
  19410127  19420215  19430205  19440125  19450213
  19460202  19470122  19480210  19490129  19500217
  19510206  19520127  19530214  19540203  19550124
  19560212  19570131  19580218  19590208  19600128
  19610215  19620205  19630125  19640213  19650202
  19660121  19670209  19680130  19690217  19700206
  19710127  19720215  19730203  19740123  19750211
  19760131  19770218  19780207  19790128  19800216
  19810205  19820125  19830213  19840202  19850220
  19860209  19870129  19880217  19890206  19900127
  19910215  19920204  19930123  19940210  19950131
  19960219  19970207  19980128  19990216  20000205
  20010124  20020212  20030201  20040122  20050209
  20060129  20070218  20080207  20090126  20100214
  20110203  20120123  20130210  20140131  20150219
  20160208  20170128  20180216  20190205  20200125
  20210212  20220201  20230122  20240210  20250129
  20260217  20270206  20280126  20290213  20300203
  20310123  20320211  20330131  20340219  20350208
  20360128  20370215  20380204  20390124  20400212
  20410201  20420122  20430210  20440130  20450217
  20460206  20470126  20480214  20490202  20500123
  20510211  20520201  20530219  20540208  20550128
  20560215  20570204  20580124  20590212  20600202
  20610121  20620209  20630129  20640217  20650205
  20660126  20670214  20680203  20690123  20700211
  20710131  20720219  20730207  20740127  20750215
  20760205  20770124  20780212  20790202  20800122
  20810209  20820129  20830217  20840206  20850126
  20860214  20870203  20880124  20890210  20900130
  20910218  20920207  20930127  20940215  20950205
  20960125  20970212  20980201  20990121  21000209
];
#_}}_


my $rH19={};
foreach my $i1 ( 0 .. $#AChineseYearCode ) {#_{{_
    my $v1 = $AChineseYearCode[$i1];
    my $s16 = sprintf "%020b", $v1;
    my ( $s4na, $s12, $s4nb ) = ( $s16 =~ m#( $pt4) ((?>\d{12})) ( $pt4) #ix );
    my $s4na0  = oct("0b$s4na");
    my $s4nb0  = oct("0b$s4nb");
    my @Amon   = ( $s12 =~ m#[01]#g );
    my @Am2    = map { ($_) ? 30 : 29 } @Amon;
    my $rH5472 = {};
    my $leapMD = 0;
    if ($s4nb0) {
        $rH5472->{LeapM} = $s4nb0;
        $leapMD = ($s4na0) ? 30 : 29;
        $rH5472->{LeapMDays} = $leapMD;
    }
    my $ct7182 = 0;
    foreach my $i3 ( 0 .. $#Am2 ) {
        my $i3a = $i3 + 1;
        $rH5472->{$i3a}{"Monthday"}    = $Am2[$i3];
        $rH5472->{$i3a}{"AccMonthday"} = $ct7182;
        $ct7182 += $Am2[$i3];
        if ( $i3a == $s4nb0 ) {    # leap month
            my $i3b = qq/${i3a}L/;
            $rH5472->{$i3b}{"Monthday"}    = $leapMD;
            $rH5472->{$i3b}{"AccMonthday"} = $ct7182;
            $ct7182 += $leapMD;
        } else {
            # else body
        }    # end of if-else on condition $i3a==$s4nb0
    }
    $rH19->{$i1} = $rH5472;
}#_}}_

sub zhDate2wDate 
{#_{{_
    my ( $Yr, $LMn, $LDy ) = @_;
    $LMn =~s#^[0]+##;
    $LDy =~s#^[0]+##;
    if ( $Yr =~ m#$pt4# ) {
    } else {
        Carp::confess "please provide year like 2020 ";
    }
    my $YrEntry = $Yr - 1900;
    if ( $YrEntry < 201 and $YrEntry > -1 ) {

    } else {
        Carp::confess "Please provide year between 1900 and 2100";
    }    # end of if-else on condition  $YrEntry < 201 and $YrEntry > -1

    my $rH3652 ;
    my $rH681 = {};
    if ( $rH19->{$YrEntry} ) {
        $rH3652 = $rH19->{$YrEntry};
        if ( defined $rH3652->{$LMn} ) {
            $rH681 = $rH3652->{$LMn};
        } else {
            Carp::confess "cannot find month for lunar months info";
        }    # end of if-else on condition defined
    } else {
        Carp::confess "cannot find Year for lunar months info";
    }    # end of if-else on condition
    my $Days3409 = 0;
    my $mday6323 = 0;
    if ( defined $rH681->{Monthday} ) {
        $mday6323 = $rH681->{Monthday};
    } else {
        Carp::confess "cannot find Lunar Month info";
    }
    if ( defined $rH681->{AccMonthday} ) {
        $Days3409 = $rH681->{AccMonthday};
    } else {
        Carp::confess "cannot find AccLunar Month info";
    }    
    my $strd1 = $AChineseNewYear[$YrEntry];
    my @ALNYear = ( $strd1 =~ m#($pt4) ($pt2) ($pt2)#x );
    map {s/^0+//} @ALNYear;
    if ( $LDy > 0 ) {
        $Days3409 += ( $LDy - 1 );
    } elsif ( $LDy == 0 ) { # 0th-day is the first day
        $Days3409 += 0;
    } else {    #negative $LDy
        $Days3409 += ( $mday6323 + $LDy );
    }    # end of if-else on condition $LDy>=0
    my @A2 = &Add_Delta_Days( @ALNYear, $Days3409 );
    return @A2;
}    # end_of func zhDate2wDate}}

1;
__END__



